home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 08 - 1992 / 08.03 Jul 92 / Matrix Parser / Commands < prev    next >
Encoding:
Text File  |  1992-12-24  |  8.3 KB  |  449 lines  |  [TEXT/PJMM]
  1. unit Commands;
  2.  
  3.  
  4. interface
  5.  
  6.  
  7.     uses
  8.  
  9.         Globals;
  10.  
  11.     procedure setdecimal;
  12.  
  13.     procedure clearscreen (var line: str255);
  14.  
  15.     procedure deletevariable (var savename: stringsize);
  16.  
  17.     procedure cleanupvariables;
  18.  
  19.     procedure createamatrix (var savename: stringsize; var mrows, ncols: longint; var kmat: longint);
  20.  
  21.     procedure readmatrix (var savename: stringsize);
  22.  
  23.     procedure readvariables;
  24.  
  25.     procedure listvariables;
  26.  
  27.     procedure storevariables;
  28.  
  29.  
  30. implementation
  31.  
  32.  
  33.     procedure setdecimal;
  34.  
  35.     begin
  36.         writeln('set number of decimal places to');
  37.         write(blank);
  38.         readln(decplace);
  39.         decplaceplus10 := decplace + 10;
  40.     end;
  41.  
  42.  
  43.     procedure ClearScreen;
  44.  
  45.  
  46.         var
  47.             place: longint;
  48.  
  49.     begin
  50.  
  51.         place := pos(blank, line);
  52.         while place <> 0 do
  53.             begin
  54.                 delete(line, place, 1);
  55.                 place := pos(blank, line);
  56.             end;
  57.  
  58.         place := pos('cls', line);
  59.         delete(line, place, 4);
  60.         if line <> '' then
  61.             writeln('cls is a reserved word for clearing the screen');
  62.         if line = '' then
  63.             rewrite(output);
  64.     end;
  65.  
  66.     procedure deletevariable;
  67.  
  68.         var
  69.             i, j, k: longint;
  70.             vRefNum: integer;
  71.             err: OSErr;
  72.             name: str255;
  73.  
  74.  
  75.     begin
  76.  
  77.         for i := 1 to numvariables do
  78.             begin
  79.                 j := numvariables + 1 - i;
  80.                 if strvar^^[j]^^ = savename then
  81.                     begin
  82.                         strvar^^[j]^^ := '';
  83.                         if matrixstoredinfile^^[j] then
  84.                             begin
  85.                                 err := GetVol(@name, vRefNum);
  86.                                 name := savename;
  87.                                 err := FSDelete(name, vRefNum);
  88.                                 matrixstoredinfile^^[j] := false;
  89.                             end;
  90.                     end;
  91.             end;
  92.  
  93.     end;
  94.  
  95.  
  96.  
  97.     procedure cleanupvariables;
  98.  
  99.         var
  100.             i, j, k, vRefNum: longint;
  101.             savename: stringsize;
  102.  
  103.  
  104.     begin
  105.  
  106.         for i := 1 to numvariables do
  107.             begin
  108.                 j := numvariables + 1 - i;
  109.                 for k := 1 to j - 1 do
  110.                     if strvar^^[k]^^ = strvar^^[j]^^ then
  111.                         begin
  112.                             savename := strvar^^[k]^^;
  113.                             deletevariable(savename);
  114.                         end;
  115.             end;
  116.  
  117.     end;
  118.  
  119.     procedure createamatrix;
  120.  
  121.         label
  122.             666;
  123.  
  124.         var
  125.             i, j: longint;
  126.             stored: boolean;
  127.             rows, cols: extended;
  128.             freebytes: longint;
  129.  
  130.     begin
  131.  
  132.         stored := false;
  133.         for i := 1 to numvariables do
  134.             begin
  135.                 j := numvariables + 1 - i;
  136.                 if strvar^^[j]^^ = savename then
  137.                     begin
  138.                         stored := true;
  139.                         deletevariable(savename);
  140.                         goto 666;
  141.                     end;
  142.             end;
  143.  
  144.         if stored = false then
  145.             begin
  146.                 numvariables := numvariables + 1;
  147.                 j := numvariables;
  148.             end;
  149.  
  150. 666:
  151.         matrixstoredinfile^^[j] := false;
  152.         rows := mrows;
  153.         cols := ncols;
  154.         if rows * cols >= bignumber then
  155.             matrixstoredinfile^^[j] := true;
  156.  
  157.         strvar^^[j] := hdlstringsize(NewHandle(SizeOf(stringsize)));
  158.         strvar^^[j]^^ := savename;
  159.  
  160.         if matrixstoredinfile^^[j] then
  161.             begin
  162.                 mfilenew^^[j] := true;
  163.                 matfile^^[j] := hdlextendedfile(NewHandle(SizeOf(extendedfile)));
  164.             end;
  165.  
  166.         if not matrixstoredinfile^^[j] then
  167.             begin
  168.                 matrixnew^^[j] := true;
  169.                 blocksize := longint(10 * mrows * ncols + 20);
  170.                 storematrix^^[j] := hdlsinglearraymatrix(NewHandle(blocksize));
  171.             end;
  172.  
  173.         kmat := j;
  174.  
  175.     end;
  176.  
  177.  
  178.     procedure readmatrix;
  179.  
  180.         label
  181.             998;
  182.  
  183.         var
  184.             margin, i, j, k, l, m, n, p, q: longint;
  185.             mrows, ncols: longint;
  186.             dumextended: extended;
  187.             large: boolean;
  188.  
  189.     begin
  190.  
  191.         margin := 90 div decplaceplus10 - 1;
  192.         large := false;
  193.         if numvariables = 0 then
  194.             begin
  195.                 writeln('no matrices stored');
  196.                 goto 998;
  197.             end;
  198.  
  199.  
  200.         for i := 1 to numvariables do
  201.             begin
  202.                 j := numvariables + 1 - i;
  203.                 if strvar^^[j]^^ = savename then
  204.                     begin
  205.                         if matrixstoredinfile^^[j] then
  206.                             begin
  207.                                 if not mfileopen^^[j] then
  208.                                     begin
  209.                                         open(matfile^^[j]^^, savename);
  210.                                         mfileopen^^[j] := true;
  211.                                     end;
  212.  
  213.                                 reset(matfile^^[j]^^);
  214.                                 if eof(matfile^^[j]^^) then
  215.                                     begin
  216.                                         writeln('no data in matrix    ', savename);
  217.                                         goto 998;
  218.                                     end;
  219.  
  220.                                 read(matfile^^[j]^^, dumextended);
  221.                                 mrows := round(dumextended);
  222.                                 read(matfile^^[j]^^, dumextended);
  223.                                 ncols := round(dumextended);
  224.                                 if ncols > margin then
  225.                                     large := true;
  226.                                 for l := 1 to mrows do
  227.                                     begin
  228.                                         if large then
  229.                                             writeln('row', l : 4);
  230.                                         for m := 1 to ncols do
  231.                                             begin
  232.                                                 read(matfile^^[j]^^, dumextended);
  233.                                                 write(dumextended : decplaceplus10 : decplace);
  234.                                                 if large then
  235.                                                     begin
  236.                                                         q := m mod margin;
  237.                                                         if q = 0 then
  238.                                                             write(chr(13));
  239.                                                     end;
  240.                                             end;
  241.                                         if large then
  242.                                             writeln(chr(13))
  243.                                         else
  244.                                             writeln;
  245.                                     end;
  246.  
  247.                                 if mfileopen^^[j] then
  248.                                     begin
  249.                                         close(matfile^^[j]^^);
  250.                                         mfileopen^^[j] := false;
  251.                                     end;
  252.                                 goto 998;
  253.                             end;
  254.  
  255.                         if not matrixstoredinfile^^[j] then
  256.                             begin
  257.  
  258.                                 n := j;
  259.  
  260.                                 mrows := round(storematrix^^[n]^^[1]);
  261.                                 ncols := round(storematrix^^[n]^^[2]);
  262.                                 if ncols > margin then
  263.                                     large := true;
  264.  
  265.                                 p := 2;
  266.                                 for l := 1 to mrows do
  267.                                     begin
  268.                                         if large then
  269.                                             writeln('row', l : 4);
  270.                                         for m := 1 to ncols do
  271.                                             begin
  272.                                                 p := p + 1;
  273.                                                 write(storematrix^^[n]^^[p] : decplaceplus10 : decplace);
  274.                                                 if large then
  275.                                                     begin
  276.                                                         q := m mod margin;
  277.                                                         if q = 0 then
  278.                                                             write(chr(13));
  279.                                                     end;
  280.                                             end;
  281.                                         if large then
  282.                                             writeln(chr(13))
  283.                                         else
  284.                                             writeln;
  285.                                     end;
  286.  
  287.  
  288.                             end;
  289.  
  290.                     end;
  291.             end;
  292.  
  293. 998:
  294.     end;
  295.  
  296.  
  297.     procedure readvariables;
  298.  
  299.         label
  300.             999;
  301.  
  302.         var
  303.             i, m, n, dumlongint: longint;
  304.             dumstring: stringsize;
  305.             dumextended: extended;
  306.             dumboolean: boolean;
  307.  
  308.     begin
  309.  
  310.  
  311.         if not varfileopen then
  312.             begin
  313.                 open(varfile, varfilename);
  314.                 varfileopen := true;
  315.             end;
  316.  
  317.         reset(varfile);
  318.  
  319.         if eof(varfile) then
  320.             goto 999;
  321.  
  322.         numvariables := 0;
  323.  
  324.         while not eof(varfile) do
  325.             begin
  326.                 numvariables := numvariables + 1;
  327.  
  328.                 readln(varfile, dumstring);
  329.                 strvar^^[numvariables] := hdlstringsize(NewHandle(SizeOf(stringsize)));
  330.                 strvar^^[numvariables]^^ := dumstring;
  331.  
  332.                 readln(varfile, dumlongint);
  333.  
  334.                 readln(varfile, dumboolean);
  335.                 matrixstoredinfile^^[numvariables] := dumboolean;
  336.  
  337.                 if matrixstoredinfile^^[numvariables] then
  338.                     begin
  339.                         mfilenew^^[numvariables] := true;
  340.                         matfile^^[numvariables] := hdlextendedfile(NewHandle(SizeOf(extendedfile)));
  341.                     end;
  342.  
  343.                 if not matrixstoredinfile^^[numvariables] then
  344.                     begin
  345.                         matrixnew^^[numvariables] := true;
  346.  
  347.                         readln(varfile, dumextended);
  348.                         m := round(dumextended);
  349.                         readln(varfile, dumextended);
  350.                         n := round(dumextended);
  351.  
  352.                         blocksize := longint(10 * m * n + 20);
  353.                         storematrix^^[numvariables] := hdlsinglearraymatrix(NewHandle(blocksize));
  354.  
  355.  
  356.                         storematrix^^[numvariables]^^[1] := m;
  357.                         storematrix^^[numvariables]^^[2] := n;
  358.  
  359.                         for i := 1 to m * n do
  360.                             begin
  361.                                 readln(varfile, dumextended);
  362.                                 storematrix^^[numvariables]^^[i + 2] := dumextended;
  363.                             end;
  364.                     end;
  365.  
  366.             end;
  367.  
  368. 999:
  369.     end;
  370.  
  371.  
  372.     procedure listvariables;
  373.  
  374.         var
  375.             i, m, n: longint;
  376.  
  377.     begin
  378.  
  379.         cleanupvariables;
  380.  
  381.         for i := 1 to numvariables do
  382.             begin
  383.                 if strvar^^[i]^^ <> '' then
  384.                     begin
  385.                         if not matrixstoredinfile^^[i] then
  386.                             begin
  387.                                 m := round(storematrix^^[i]^^[1]);
  388.                                 n := round(storematrix^^[i]^^[2]);
  389.                                 if (m = 1) and (n = 1) then
  390.                                     writeln(strvar^^[i]^^, '    ', storematrix^^[i]^^[3] : decplaceplus10 : decplace)
  391.                                 else
  392.                                     writeln(strvar^^[i]^^, '   matrix   ', m, '  rows, ', n, ' cols ');
  393.                             end;
  394.                         if matrixstoredinfile^^[i] then
  395.                             writeln(strvar^^[i]^^, '    ', i : 5);
  396.                     end;
  397.             end;
  398.  
  399.  
  400.     end;
  401.  
  402.  
  403.     procedure storevariables;
  404.  
  405.         var
  406.             i, j, m, n: longint;
  407.             vRefNum: integer;
  408.             name: str255;
  409.             fileinfo: fInfo;
  410.             err: OSErr;
  411.  
  412.     begin
  413.  
  414.         decplace := 20;
  415.         decplaceplus10 := decplace + 10;
  416.  
  417.         if not varfileopen then
  418.             begin
  419.                 open(varfile, varfilename);
  420.                 varfileopen := true;
  421.             end;
  422.  
  423.         rewrite(varfile);
  424.  
  425.         cleanupvariables;
  426.  
  427.         for i := 1 to numvariables do
  428.             begin
  429.                 writeln(varfile, strvar^^[i]^^);
  430.                 writeln(varfile, i : 5);
  431.                 writeln(varfile, matrixstoredinfile^^[i]);
  432.                 if not matrixstoredinfile^^[i] then
  433.                     begin
  434.                         m := round(storematrix^^[i]^^[1]);
  435.                         n := round(storematrix^^[i]^^[2]);
  436.                         for j := 1 to m * n + 2 do
  437.                             writeln(varfile, storematrix^^[i]^^[j] : decplaceplus10 : decplace);
  438.                     end;
  439.             end;
  440.  
  441.         err := GetVol(@name, vRefNum);
  442.         name := varfilename;
  443.         fileinfo.fdFlags := fInvisible;
  444.         err := SetFInfo(name, vRefNum, fileinfo);
  445.  
  446.     end;
  447.  
  448.  
  449. end.